home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / dev / lang / sbp3_1e.lzh / XSHELL.PL < prev    next >
Text File  |  1991-10-31  |  7KB  |  214 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7.  
  8. /* XSHELL.PL */
  9.  
  10. /*
  11.  * An expert system consultation driver to be used     
  12.  * with separately written knowledge bases.            
  13.  *
  14.  * Procedures in the file include XSHELL, XSHELL_AUX,  
  15.  * FINISH_XSHELL, PROP, PARM, PARMSET, PARMRANGE,      
  16.  * EXPLAIN, MEMBER, and WAIT.                          
  17.  *
  18.  * Requires various procedures defined in the files
  19.  * READSTR.PL, READNUM.PL, WRITELN.PL, and YES.PL
  20.  * from Chapter 5.
  21.  *
  22.  */
  23.  
  24. :- ( clause(readstring(_),_) ; consult('readstr.pl') ). 
  25. :- ( clause(readnumber(_),_) ; consult('readnum.pl') ).
  26. :- ( clause(writeln(_),_) ; consult('writeln.pl') ). 
  27. :- ( clause(yes(_),_) ; consult('yes.pl') ).
  28.  
  29. /*
  30.  * xshell                                                    
  31.  *   As a query, this predicate begins a consultation. It is
  32.  *   the main program or procedure for the expert system 
  33.  *   consultation driver. It always succeeds. 
  34.  */
  35.  
  36. xshell :- xkb_intro(Statement),  
  37.           writeln(Statement), nl,  
  38.           xkb_identify(ID),             
  39.           asserta(known(identification,ID)), 
  40.           xkb_report(Phrase),           
  41.           write(Phrase),                
  42.           writeln(ID), nl,          
  43.           explain,
  44.           xkb_unique(yes),              
  45.           !,                            
  46.           xshell_aux.
  47.  
  48. xshell :- xshell_aux.
  49.  
  50. /*
  51.  * xshell_aux 
  52.  *   Prevents an abrupt end to a consultation that ends 
  53.  * without an identification, or a consultation where 
  54.  * multiple identifications are allowed. 
  55.  */ 
  56.  
  57. xshell_aux :- known(identification,_),   
  58.               writeln('I cannot reach a conclusion.'),
  59.               !,
  60.               finish_xshell.
  61.  
  62. xshell_aux :- xkb_unique(no),  
  63.               known(identification,_),
  64.               writeln('I cannot reach any further conclusion.'),
  65.               !,                            
  66.               finish_xshell.
  67.  
  68. xshell_aux :- finish_xshell.     
  69.  
  70. /*                                 
  71.  * finish_xshell                                               
  72.  *   Erases the working database and asks if the user wants  
  73.  *   to conduct another consultation.  Use retractall instead  
  74.  *   of abolish in some Prolog implementations.
  75.  */
  76.  
  77. finish_xshell :-
  78.      abolish(known,2),
  79.      writeln('Do you want to conduct another consultation?'),
  80.      yes('>'), nl, nl,
  81.      !,
  82.      xshell.  
  83.  
  84. finish_xshell.
  85.  
  86. /*
  87.  * prop(Property)
  88.  *   Succeeds if it is remembered from an earlier call that  
  89.  *   the subject has the Property.  Otherwise the user is  
  90.  *   asked if the subject has the Property and the user's  
  91.  *   answer is remembered. In this case, the procedure call
  92.  *   succeeds only if the user answers 'yes'. 
  93.  */
  94.  
  95. prop(Property) :- known(Property,Value),
  96.                   !,           
  97.                   Value == y.  
  98.  
  99. prop(Property) :- xkb_question(Property,Question),
  100.                   writeln(Question),
  101.                   yes('>'), nl, nl,
  102.                   assert(known(Property,y)), 
  103.                   !.
  104.  
  105. prop(Property) :- assert(known(Property,n)),    
  106.                   nl, nl,
  107.                   !,
  108.                   fail.
  109.  
  110. /*
  111.  * parm(Parameter,Type,Value)
  112.  *   Type determines whether Value is to be a character, an   
  113.  *   atom, or a number.  Value becomes the remembered value
  114.  *   for the parameter if there is one. Otherwise the user is  
  115.  *   asked for a value and that value is remembered. When 
  116.  *   used as a test condition, Value is instantiated before
  117.  *   the procedure is called and parm(Parameter,Type,Value)  
  118.  *   only succeeds if the remembered value, or alternatively 
  119.  *   the value reported by the user, matches Value.          
  120.  */
  121.  
  122. parm(Parameter,_,Value) :- known(Parameter,StoredValue),
  123.                            !,
  124.                            Value = StoredValue.
  125.  
  126. parm(Parameter,c,Value) :- xkb_question(Parameter,Question),
  127.                            writeln(Question),
  128.                            write('>'),
  129.                            get1(Char), nl, nl,
  130.                            name(Response,[Char]), 
  131.                            assert(known(Parameter,Response)), 
  132.                            !,
  133.                            Value = Response.
  134.  
  135. parm(Parameter,a,Value) :- xkb_question(Parameter,Question),
  136.                            writeln(Question),
  137.                            readatom(Response), nl, nl,
  138.                            assert(known(Parameter,Response)),
  139.                            !,
  140.                            Value = Response.
  141.  
  142. parm(Parameter,n,Value) :- xkb_question(Parameter,Question),
  143.                            writeln(Question),
  144.                            readnumber(Response), nl, nl,
  145.                            assert(known(Parameter,Response)),
  146.                            !,
  147.                            Value = Response.
  148.  
  149. /*
  150.  * parmset(Parameter,Type,Set)
  151.  *   Type indicates whether the Parameter takes a character, 
  152.  *   an atom, or a number as value, and Set is a list of 
  153.  *   possible values for Parameter.  A call to the procedure 
  154.  *   succeeds if a value for Parameter is established that is
  155.  *   a member of Set.
  156.  */
  157.  
  158. parmset(Parameter,Type,Set) :- parm(Parameter,Type,Value),
  159.                                member(Value,Set).
  160.  
  161. /*
  162.  * parmrange(Parameter,Minimum,Maximum)
  163.  *   Parameter should be a parameter that takes numbers as   
  164.  *   values, and Minimum and Maximum should be numbers.  A 
  165.  *   call to the procedure succeeds if a value for Parameter 
  166.  *   is established that is in the closed interval           
  167.  *   [Minimum,Maximum].                                      
  168.  */
  169.  
  170. parmrange(Parameter,Minimum,Maximum) :- 
  171.      parm(Parameter,n,Value),                                
  172.      Minimum =< Value,                                       
  173.      Maximum >= Value.
  174.  
  175. /*
  176.  * explain
  177.  *   Explains how the expert system arrived at a conclusion 
  178.  *   by finding an identification rule for the conclusion in 
  179.  *   the knowledge base whose condition succeeds and showing 
  180.  *   it to the user.  If xkb_explain(no) is in the knowledge 
  181.  *   base explain merely waits for a keystroke to give the 
  182.  *   user time to read the conclusion. 
  183.  */
  184.  
  185. explain :- xkb_explain(no), wait, !.
  186.  
  187. explain :- writeln(
  188.            ['Do you want to see the rule that was used',
  189.             'to reach the conclusion?']),
  190.            \+ yes('>'), nl, !.
  191.  
  192. explain :- known(identification,ID),
  193.            clause(xkb_identify(ID),Condition),
  194.            Condition, nl, nl,
  195.            write('Rule: '),
  196.            xkb_report(Phrase),
  197.            write(Phrase),
  198.            writeln(ID),
  199.            writeln('    if'),
  200.            write(Condition), nl, nl, !.
  201.  
  202. /*
  203.  * wait
  204.  *   Prints prompt and waits for keystroke.
  205.  */ 
  206.  
  207. wait :- write('Press Return when ready to continue. '),
  208.         get0(_), nl, nl.  % Even ALS can use get0 here.
  209.  
  210.  
  211.  
  212. member(X,[X|_]).
  213. member(X,[_|Y]) :- member(X,Y).
  214.